home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / page-ext.el < prev    next >
Text File  |  1993-11-14  |  28KB  |  770 lines
  1. ;;; page-ext.el --- extended page handling commands
  2.  
  3. ;; You may use these commands to handle an address list or other
  4. ;; small data base.
  5.  
  6. ;; Copyright (C) 1990, 1991, 1993 Free Software Foundation
  7.  
  8. ;; Maintainer: Robert J. Chassell <bob@gnu.ai.mit.edu>
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26.  
  27. ;;; Summary
  28.  
  29. ; The current page commands are:
  30.  
  31. ;     forward-page         C-x ]
  32. ;     backward-page        C-x [
  33. ;     narrow-to-page       C-x p
  34. ;     count-lines-page     C-x l
  35. ;     mark-page            C-x C-p  (change this to C-x C-p C-m)
  36. ;     sort-pages           not bound
  37. ;     what-page            not bound
  38.  
  39. ; The new page handling commands all use `C-x C-p' as a prefix.  This
  40. ; means that the key binding for `mark-page' must be changed.
  41. ; Otherwise, no other changes are made to the current commands or
  42. ; their bindings.
  43.  
  44. ; New page handling commands:
  45.  
  46. ;     next-page                        C-x C-p C-n
  47. ;     previous-page                    C-x C-p C-p
  48. ;     search-pages                     C-x C-p C-s
  49. ;     add-new-page                     C-x C-p C-a
  50. ;     sort-pages-buffer                C-x C-p s      
  51. ;     set-page-delimiter               C-x C-p C-l
  52. ;     pages-directory                  C-x C-p C-d   
  53. ;     pages-directory-for-addresses    C-x C-p d
  54. ;        pages-directory-goto          C-c C-c
  55.  
  56.  
  57. ;;; Using the page commands
  58.  
  59. ; The page commands are helpful in several different contexts.  For
  60. ; example, programmers often divide source files into sections using the
  61. ; `page-delimiter'; you can use the `pages-directory' command to list
  62. ; the sections.
  63.  
  64. ; You may change the buffer local value of the `page-delimiter' with
  65. ; the `set-page-delimiter' command.  This command is bound to `C-x C-p
  66. ; C-l' The command prompts you for a new value for the page-delimiter.
  67. ; Called with a prefix-arg, the command resets the value of the
  68. ; page-delimiter to its original value.
  69.  
  70. ; You may set several user options:
  71. ;
  72. ;   The `pages-directory-buffer-narrowing-p' variable causes the
  73. ;   `pages-directory-goto' command to narrow to the destination page.
  74. ;
  75. ;   The `pages-directory-for-adding-page-narrowing-p' variable, causes the
  76. ;   `add-new-page' command to narrow to the new entry.
  77. ;
  78. ;   The `pages-directory-for-adding-new-page-before-current-page-p' variable
  79. ;   causes the `add-new-page' command to insert a new page before current
  80. ;   page.
  81. ;
  82. ; These variables are true by default.
  83. ;
  84. ; Additional, addresses-related user options are described in the next page
  85. ; of this file.
  86.  
  87.  
  88. ;;; Handling an address list or small data base
  89.  
  90. ; You may use the page commands to handle an address list or other
  91. ; small data base.  Put each address or entry on its own page.  The
  92. ; first line of text in each page is a `header line' and is listed by
  93. ; the `pages-directory' or `pages-directory-for-addresses' command.
  94.  
  95. ; Specifically:
  96. ; 
  97. ;   1. Begin each entry with a `page-delimiter' (which is, by default,
  98. ;      `^L' at the beginning of the line).
  99. ; 
  100. ;   2. The first line of text in each entry is the `heading line'; it
  101. ;      will appear in the pages-directory-buffer which is constructed
  102. ;      using the `C-x C-p C-d' (pages-directory) command or the `C-x
  103. ;      C-p d' (pages-directory-for-addresses) command.
  104. ; 
  105. ;      The heading line may be on the same line as the page-delimiter
  106. ;      or it may follow after.  It is the first non-blank line on the
  107. ;      page.  Conventionally, the heading line is placed on the line
  108. ;      immediately following the line containing page-delimiter.
  109. ;
  110. ;   3. Follow the heading line with the body of the entry.  The body
  111. ;      extends up to the next `page-delimiter'.  The body may be of any
  112. ;      length.  It is conventional to place a blank line after the last
  113. ;      line of the body.
  114.  
  115. ; For example, a file might look like this:
  116. ; 
  117. ;     FSF
  118. ;     Free Software Foundation
  119. ;     675 Massachusetts Avenue
  120. ;     Cambridge, MA 02139  USA
  121. ;     (617) 876-3296
  122. ;     gnu@prep.ai.mit.edu
  123. ; 
  124. ;     
  125. ;     House Subcommittee on Intellectual Property,
  126. ;     U.S. House of Representatives,
  127. ;     Washington, DC  20515
  128. ;     
  129. ;     Congressional committee concerned with permitting or preventing
  130. ;     monopolistic restrictions on the use of software technology.
  131. ; 
  132. ;     
  133. ;     George Lakoff
  134. ;     ``Women, Fire, and Dangerous Things:
  135. ;     What Categories Reveal about the Mind''
  136. ;     1987, Univ. of Chicago Press
  137. ; 
  138. ;     About philosophy, Whorfian effects, and linguistics.
  139. ; 
  140. ;       
  141. ;     OBI   (On line text collection.)
  142. ;     Open Book Initiative
  143. ;     c/o Software Tool & Die
  144. ;     1330 Beacon St, Brookline, MA 02146 USA
  145. ;     (617) 739-0202 
  146. ;     obi@world.std.com
  147.  
  148. ; In this example, the heading lines are:
  149. ;
  150. ;     FSF
  151. ;     House Subcommittee on Intellectual Property
  152. ;     George Lakoff
  153. ;     OBI (On line text collection.)
  154.  
  155. ; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
  156. ; buffer alphabetically.
  157.  
  158. ; You may use any of the page commands, including the `next-page',
  159. ; `previous-page', `add-new-page', `mark-page', and `search-pages'
  160. ; commands.
  161.  
  162. ; You may use either the `C-x C-p d' (pages-directory-for-addresses)
  163. ; or the `C-x C-p C-d' (pages-directory) command to construct and
  164. ; dislay a directory of all the heading lines.
  165.  
  166. ; In the directory, you may position the cursor over a heading line
  167. ; and type `C-c C-c' (pages-directory-goto) to go to the entry to
  168. ; which it refers in the pages buffer.
  169.  
  170. ; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
  171. ; pages buffer or address file.  This is the same command you use to
  172. ; add a new entry when you are in the pages buffer or address file.
  173.  
  174. ; If you wish, you may create several different directories,
  175. ; one for each different buffer.
  176.  
  177. ;; `pages-directory-for-addresses' in detail
  178.  
  179. ; The `pages-directory-for-addresses' assumes a default addresses
  180. ; file.  You do not need to specify the addresses file but merely type
  181. ; `C-x C-p d' from any buffer.  The command finds the file, constructs
  182. ; a directory for it, and switches you to the directory.  If you call
  183. ; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
  184. ; file name.
  185.  
  186. ; You may customize the addresses commands:
  187.  
  188. ;   The `pages-addresses-file-name' variable determines the name of
  189. ;   the addresses file; by default it is "~/addresses".
  190.  
  191. ;   The `pages-directory-for-addresses-goto-narrowing-p' variable
  192. ;   determines whether `pages-directory-goto' narrows the addresses
  193. ;   buffer to the entry, which it does by default.
  194.  
  195. ;   The `pages-directory-for-addresses-buffer-keep-windows-p' variable
  196. ;   determines whether `pages-directory-for-addresses' deletes other
  197. ;   windows to show as many lines as possible on the screen or works
  198. ;   in the usual Emacs manner and keeps other windows.  Default is to
  199. ;   keep other windows.
  200.  
  201. ;   The `pages-directory-for-adding-addresses-narrowing-p' variable
  202. ;   determines whether `pages-directory-for-addresses' narrows the
  203. ;   addresses buffer to a new entry when you are adding that entry.
  204. ;   Default is to narrow to new entry, which means you see a blank
  205. ;   screen before you write the new entry.
  206.  
  207. ;; `pages-directory' in detail
  208.  
  209. ; Call the `pages-directory' command from the buffer for which you
  210. ; want a directory created; it creates a directory for the buffer and
  211. ; pops you to the directory.
  212.  
  213. ; The `pages-directory' command has several options:
  214.  
  215. ;   Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
  216. ;   prompts you for a regular expression and only lists only those
  217. ;   header lines that are part of pages that contain matches to the
  218. ;   regexp.  In the example above, `C-u C-x C-p C-d 617 RET' would
  219. ;   match the telephone area code of the first and fourth entries, so
  220. ;   only the header lines of those two entries would appear in the
  221. ;   pages-directory-buffer.
  222. ; 
  223. ;   Called with a numeric argument, the `pages-directory' command
  224. ;   lists the number of lines in each page.  This is helpful when you
  225. ;   are printing hardcopy.  
  226.  
  227. ;   Called with a negative numeric argument, the `pages-directory'
  228. ;   command lists the lengths of pages whose contents match a regexp.
  229.  
  230. ;;; Code:
  231.  
  232.  
  233. ;;; Customarily customizable variable definitions
  234.  
  235. (defvar pages-directory-buffer-narrowing-p t
  236.   "*If non-nil, `pages-directory-goto' narrows pages buffer to entry.")
  237.  
  238. (defvar pages-directory-for-adding-page-narrowing-p t
  239.   "*If non-nil, `add-new-page' narrows page buffer to new entry.")
  240.  
  241. (defvar pages-directory-for-adding-new-page-before-current-page-p t
  242.   "*If non-nil, `add-new-page' inserts new page before current page.")
  243.  
  244.  
  245. ;;; Addresses related variables
  246.  
  247. (defvar pages-addresses-file-name "~/addresses"
  248.   "*Standard name for file of addresses. Entries separated by page-delimiter.
  249. Used by `pages-directory-for-addresses' function.")
  250.  
  251. (defvar pages-directory-for-addresses-goto-narrowing-p t
  252.   "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.")
  253.  
  254. (defvar pages-directory-for-addresses-buffer-keep-windows-p t
  255.   "*If nil, `pages-directory-for-addresses' deletes other windows.")
  256.  
  257. (defvar pages-directory-for-adding-addresses-narrowing-p t
  258.   "*If non-nil, `add-new-page' narrows addresses buffer to new entry.")
  259.  
  260.  
  261. ;;; Key bindings for page handling functions
  262.  
  263. (global-unset-key "\C-x\C-p")
  264.  
  265. (defvar ctl-x-ctl-p-map (make-sparse-keymap)
  266.   "Keymap for subcommands of C-x C-p, which are for page handling.")
  267.  
  268. (define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
  269. (fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
  270.  
  271. (define-key ctl-x-ctl-p-map "\C-n" 'next-page)
  272. (define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
  273. (define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
  274. (define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
  275. (define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
  276. (define-key ctl-x-ctl-p-map "s"    'sort-pages-buffer)
  277. (define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
  278. (define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
  279. (define-key ctl-x-ctl-p-map "d"    'pages-directory-for-addresses)
  280.  
  281.  
  282. ;;; Page movement function definitions
  283.  
  284. (defun next-page (&optional count)
  285.   "Move to the next page bounded by the `page-delimiter' variable.
  286. With arg (prefix if interactive), move that many pages."
  287.   (interactive "p")
  288.   (or count (setq count 1))
  289.   (widen)
  290.   ;; Cannot use forward-page because of problems at page boundaries.
  291.   (while (and (> count 0) (not (eobp)))
  292.     (if (re-search-forward page-delimiter nil t)
  293.         nil
  294.       (goto-char (point-max)))
  295.     (setq count (1- count)))
  296.   ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries.
  297.   ;; The first page boundary we reach is the top of the current page,
  298.   ;; which doesn't count.
  299.   (while (and (< count 1) (not (bobp)))
  300.     (if (re-search-backward page-delimiter nil t)
  301.     (goto-char (match-beginning 0))
  302.       (goto-char (point-min)))
  303.     (setq count (1+ count)))
  304.   (narrow-to-page)
  305.   (goto-char (point-min))
  306.   (recenter 0))
  307.  
  308. (defun previous-page (&optional count)
  309.   "Move to the previous page bounded by the `page-delimiter' variable.
  310. With arg (prefix if interactive), move that many pages."
  311.   (interactive "p")
  312.   (or count (setq count 1))
  313.   (next-page (- count)))
  314.  
  315.  
  316. ;;; Adding and searching pages
  317.  
  318. (defun add-new-page (header-line)
  319.   "Insert new page.  Prompt for header line.
  320.  
  321. If point is in the pages directory buffer, insert the new page in the
  322. buffer associated with the directory.
  323.  
  324. Insert the new page just before current page if
  325.   pages-directory-for-adding-new-page-before-current-page-p  variable
  326. is non-nil.  Else insert at exact location of point.
  327.  
  328. Narrow to new page if
  329.   pages-directory-for-adding-page-narrowing-p variable
  330. is non-nil.
  331.  
  332. Page begins with a `^L' as the default page-delimiter.  
  333. Use \\[set-page-delimiter] to change the page-delimiter.
  334. Point is left in the body of page."
  335.   (interactive "sHeader line: ")
  336.   (widen)
  337.   ;; If in pages directory buffer
  338.   (if (eq major-mode 'pages-directory-mode) 
  339.       (progn
  340.         ;; Add new page before or after current page?
  341.         (if pages-directory-for-adding-new-page-before-current-page-p
  342.             (pages-directory-goto)
  343.           (pages-directory-goto)
  344.           (forward-page)
  345.           (or (eobp) (forward-line -1)))))
  346.   (widen)
  347.   ;; Move point before current delimiter if desired.
  348.   (and pages-directory-for-adding-new-page-before-current-page-p
  349.        (if (re-search-backward page-delimiter nil t)
  350.            (goto-char (match-beginning 0))
  351.          ;; If going to beginning of file, insert a page-delimiter
  352.          ;; before current first page.
  353.          (goto-char (point-min))
  354.          (insert
  355.           (format "%s\n"
  356.                   ;; Remove leading `^' from page-delimiter string
  357.                   (if (eq '^ (car (read-from-string page-delimiter)))
  358.                       (substring page-delimiter 1))))         
  359.          (goto-char (point-min))))
  360.   ;; Insert page delimiter at beginning of line.
  361.   (if (not (looking-at "^."))   (forward-line 1))
  362.   (insert (format "%s\n%s\n\n\n" 
  363.                   (if (eq '^ (car (read-from-string page-delimiter)))
  364.                       (substring page-delimiter 1))
  365.                   header-line))
  366.   (forward-line -1)
  367.   (and pages-directory-for-adding-page-narrowing-p (narrow-to-page)))
  368.  
  369. (defvar pages-last-search nil
  370.   "Value of last regexp searched for.  Initially, nil.")
  371.  
  372. (defun search-pages (regexp)
  373.   "Search for REGEXP, starting from point, and narrow to page it is in."
  374.   (interactive (list
  375.                 (read-string
  376.                  (format "Search for `%s' (end with RET): "
  377.                          (or pages-last-search "regexp")))))
  378.   (if (equal regexp "")
  379.       (setq regexp pages-last-search)
  380.     (setq pages-last-search regexp))
  381.   (widen)
  382.   (re-search-forward regexp)
  383.   (narrow-to-page))
  384.  
  385.  
  386. ;;; Sorting pages
  387.  
  388. (autoload 'sort-subr "sort" "Primary function for sorting." t nil)
  389.  
  390. (defun sort-pages-in-region (reverse beg end)
  391.   "Sort pages in region alphabetically.  Prefix arg means reverse order.  
  392.  
  393. Called from a program, there are three arguments:
  394. REVERSE (non-nil means reverse order), BEG and END (region to sort)."
  395.  
  396. ;;; This sort function handles ends of pages differently than
  397. ;;; `sort-pages' and works better with lists of addresses and similar
  398. ;;; files.
  399.  
  400.   (interactive "P\nr")
  401.   (save-restriction
  402.     (narrow-to-region beg end)
  403.     (goto-char (point-min))
  404.     ;;; `sort-subr' takes three arguments
  405.     (sort-subr reverse
  406.  
  407.                ;; NEXTRECFUN is called with point at the end of the
  408.                ;; previous record. It moves point to the start of the
  409.                ;; next record.
  410.            (function (lambda ()
  411.                            (re-search-forward page-delimiter nil t)
  412.                            (skip-chars-forward " \t\n")
  413.                            ))
  414.  
  415.                ;; ENDRECFUN is is called with point within the record.
  416.                ;; It should move point to the end of the record.
  417.            (function (lambda ()
  418.                            (if (re-search-forward
  419.                                 page-delimiter
  420.                                 nil
  421.                                 t)
  422.                                (goto-char (match-beginning 0))
  423.                              (goto-char (point-max))))))))
  424.  
  425. (defun sort-pages-buffer (&optional reverse)
  426.   "Sort pages alphabetically in buffer.  Prefix arg means reverse order. 
  427. \(Non-nil arg if not interactive.\)"
  428.  
  429.   (interactive "P")
  430.   (or reverse (setq reverse nil))
  431.   (widen)
  432.   (let ((beginning (point-min))
  433.         (end (point-max)))
  434.     (sort-pages-in-region reverse beginning end)))
  435.  
  436.  
  437. ;;; Pages directory ancillary definitions
  438.  
  439. (defvar pages-directory-previous-regexp nil
  440.   "Value of previous regexp used by `pages-directory'.
  441. \(This regular expression may be used to select only those pages that
  442. contain matches to the regexp.\)")
  443.  
  444. (defvar pages-buffer nil
  445.   "The buffer for which the pages-directory function creates the directory.")
  446.  
  447. (defvar pages-directory-prefix "*Directory for:"
  448.   "Prefix of name of temporary buffer for pages-directory.")
  449.  
  450. (defvar pages-pos-list nil
  451.   "List containing the positions of the pages in the pages-buffer.")
  452.  
  453. (defvar pages-directory-map nil
  454.   "Keymap for the pages-directory-buffer.")
  455.  
  456. (if pages-directory-map
  457.     ()
  458.   (setq pages-directory-map (make-sparse-keymap))
  459.   (define-key pages-directory-map "\C-c\C-c"
  460.     'pages-directory-goto)
  461.   (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page))
  462.  
  463. (defvar original-page-delimiter "^ "
  464.   "Default page delimiter.")
  465.  
  466. (defun set-page-delimiter (regexp reset-p)
  467.   "Set buffer local value of page-delimiter to REGEXP.
  468. Called interactively with a prefix argument, reset `page-delimiter' to
  469. its original value.
  470.  
  471. In a program, non-nil second arg causes first arg to be ignored and
  472. resets the page-delimiter to the original value."
  473.   
  474.   (interactive
  475.    (if current-prefix-arg
  476.        (list original-page-delimiter "^ ")
  477.      (list (read-string "Set page-delimiter to regexp: " page-delimiter)
  478.            nil)))
  479.   (make-local-variable 'original-page-delimiter)
  480.   (make-local-variable 'page-delimiter)
  481.   (setq original-page-delimiter
  482.         (or original-page-delimiter page-delimiter))
  483.   (if (not reset-p)
  484.       (setq page-delimiter regexp)
  485.     (setq page-delimiter original-page-delimiter))
  486.   (if (interactive-p)
  487.       (message "The value of `page-delimiter' is now: %s" page-delimiter)))
  488.  
  489.  
  490. ;;; Pages directory main definitions
  491.  
  492. (defun pages-directory
  493.   (pages-list-all-headers-p count-lines-p &optional regexp)
  494.   "Display a directory of the page headers in a temporary buffer.
  495. A header is the first non-blank line after the page-delimiter.
  496. \\[pages-directory-mode]
  497. You may move point to one of the lines in the temporary buffer,
  498. then use \\<pages-directory-goto> to go to the same line in the pages buffer.
  499.  
  500. In interactive use:
  501.  
  502.     1. With no prefix arg, display all headers.
  503.  
  504.     2. With prefix arg, display the headers of only those pages that
  505.        contain matches to a regular expression for which you are
  506.        prompted.
  507.  
  508.     3. With numeric prefix arg, for every page, print the number of
  509.        lines within each page.
  510.  
  511.     4. With negative numeric prefix arg, for only those pages that
  512.        match a regular expression, print the number of lines within
  513.        each page.
  514.  
  515. When called from a program, non-nil first arg means list all headers;
  516. non-nil second arg means print numbers of lines in each page; if first
  517. arg is nil, optional third arg is regular expression.
  518.  
  519. If the buffer is narrowed, the `pages-directory' command creates a
  520. directory for only the accessible portion of the buffer."
  521.   
  522.   (interactive
  523.    (cond ((not current-prefix-arg)
  524.           (list t nil nil))
  525.          ((listp current-prefix-arg) 
  526.           (list nil
  527.                 nil
  528.                 (read-string
  529.                  (format "Select according to `%s' (end with RET): "
  530.                          (or pages-directory-previous-regexp "regexp")))))
  531.          ((> (prefix-numeric-value current-prefix-arg) 0)
  532.           (list t t nil))
  533.          ((< (prefix-numeric-value current-prefix-arg) 0)          
  534.           (list nil
  535.                 t
  536.                 (read-string
  537.                  (format "Select according to `%s' (end with RET): "
  538.                          (or pages-directory-previous-regexp "regexp")))))))
  539.   
  540.   (if (equal regexp "")
  541.       (setq regexp pages-directory-previous-regexp)
  542.     (setq pages-directory-previous-regexp regexp))
  543.   
  544.   (if (interactive-p)
  545.       (message "Creating directory for: %s "
  546.                (buffer-name)))
  547.   
  548.   (let ((target-buffer (current-buffer))
  549.         (pages-directory-buffer
  550.          (concat pages-directory-prefix " " (buffer-name) " "))
  551.         (linenum 1)
  552.         (pages-buffer-original-position (point))
  553.         (pages-buffer-original-page 0))
  554.     
  555.     ;; `with-output-to-temp-buffer' binds the value of the variable
  556.     ;; `standard-output' to the buffer named as its first argument,
  557.     ;; but does not switch to that buffer.
  558.     (with-output-to-temp-buffer pages-directory-buffer
  559.       (save-excursion
  560.         (set-buffer standard-output)
  561.         (pages-directory-mode)
  562.         (insert
  563.          "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
  564.         (setq pages-buffer target-buffer)
  565.         (setq pages-pos-list nil))
  566.       
  567.       (if pages-list-all-headers-p
  568.           
  569.           ;; 1. If no prefix argument, list all headers
  570.           (save-excursion
  571.             (goto-char (point-min))
  572.             
  573.             ;; (a) Point is at beginning of buffer; but the first
  574.             ;;     page may not begin with a page-delimiter
  575.             (save-restriction
  576.               ;; If page delimiter is at beginning of buffer, skip it
  577.               (if (and (save-excursion
  578.                          (re-search-forward page-delimiter nil t))
  579.                        (= 1 (match-beginning 0)))
  580.                   (goto-char (match-end 0)))
  581.               (narrow-to-page)
  582.               (pages-copy-header-and-position count-lines-p))
  583.             
  584.             ;; (b) Search within pages buffer for next page-delimiter
  585.             (while (re-search-forward page-delimiter nil t)
  586.               (pages-copy-header-and-position count-lines-p)))
  587.         
  588.         ;; 2. Else list headers whose pages match regexp.
  589.         (save-excursion
  590.           ;; REMOVED  save-restriction  AND  widen  FROM HERE
  591.           (goto-char (point-min))
  592.           
  593.           ;; (a) Handle first page
  594.           (save-restriction
  595.             (narrow-to-page)
  596.             ;; search for selection regexp
  597.             (if (save-excursion (re-search-forward regexp nil t))
  598.                 (pages-copy-header-and-position count-lines-p)))
  599.           
  600.           ;; (b) Search for next page-delimiter
  601.           (while (re-search-forward page-delimiter nil t)
  602.             (save-restriction
  603.               (narrow-to-page)
  604.               ;; search for selection regexp
  605.               (if (save-excursion (re-search-forward regexp nil t))
  606.                   (pages-copy-header-and-position count-lines-p)
  607.                 )))))
  608.       
  609.       (set-buffer standard-output)
  610.       ;; Put positions in increasing order to go with buffer.
  611.       (setq pages-pos-list (nreverse pages-pos-list))
  612.       (if (interactive-p)
  613.           (message "%d matching lines in: %s"
  614.                    (length pages-pos-list) (buffer-name target-buffer))))
  615.     (pop-to-buffer pages-directory-buffer)
  616.     (sit-for 0)  ; otherwise forward-line fails if N > window height.
  617.     (forward-line (if (= 0 pages-buffer-original-page)
  618.                       1
  619.                     pages-buffer-original-page))))
  620.  
  621. (defun pages-copy-header-and-position (count-lines-p)
  622.   "Copy page header and its position to the Pages Directory.
  623. Only arg non-nil, count lines in page and insert before header.
  624. Used by `pages-directory' function."
  625.   
  626.   (let (position line-count)
  627.  
  628.     (if count-lines-p
  629.         (save-excursion
  630.           (save-restriction
  631.             (narrow-to-page)
  632.             (setq line-count (count-lines (point-min) (point-max))))))
  633.  
  634.     ;; Keep track of page for later cursor positioning
  635.     (if (<= (point) pages-buffer-original-position)
  636.         (setq pages-buffer-original-page
  637.               (1+ pages-buffer-original-page)))
  638.     
  639.     (save-excursion
  640.       ;; go to first non-blank char after the page-delimiter
  641.       (skip-chars-forward " \t\n")     
  642.       ;; set the marker here; this the place to which the
  643.       ;; `pages-directory-goto' command will go 
  644.       (setq position (make-marker))
  645.       (set-marker position (point))
  646.       (let ((start (point))
  647.             (end (save-excursion (end-of-line) (point))))
  648.         ;; change to directory buffer
  649.         (set-buffer standard-output)
  650.         ;; record page position 
  651.         (setq pages-pos-list (cons position pages-pos-list))
  652.         ;; insert page header
  653.         (insert-buffer-substring target-buffer start end))
  654.       
  655.       (if count-lines-p
  656.           (save-excursion
  657.             (beginning-of-line)
  658.             (insert (format "%3d: " line-count))))
  659.       
  660.       (terpri))
  661.     (forward-line 1)))
  662.  
  663. (defun pages-directory-mode ()
  664.   "Mode for handling the pages-directory buffer.
  665.  
  666. Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
  667. to the same line in the pages buffer."
  668.  
  669.   (kill-all-local-variables)
  670.   (use-local-map pages-directory-map)
  671.   (setq major-mode 'pages-directory-mode)
  672.   (setq mode-name "Pages-Directory")
  673.   (make-local-variable 'pages-buffer)
  674.   (make-local-variable 'pages-pos-list)
  675.   (make-local-variable 'pages-directory-buffer-narrowing-p))
  676.  
  677. (defun pages-directory-goto ()
  678.   "Go to the corresponding line in the pages buffer."
  679.  
  680. ;;; This function is mostly a copy of `occur-mode-goto-occurrence'
  681.  
  682.   (interactive)
  683.   (if (or (not pages-buffer)
  684.       (not (buffer-name pages-buffer)))
  685.       (progn
  686.     (setq pages-buffer nil
  687.           pages-pos-list nil)
  688.     (error "Buffer in which pages were found is deleted.")))
  689.   (beginning-of-line)
  690.   (let* ((pages-number (1- (count-lines (point-min) (point))))
  691.      (pos (nth pages-number pages-pos-list))
  692.          (end-of-directory-p (eobp))
  693.          (narrowing-p  pages-directory-buffer-narrowing-p))
  694.     (pop-to-buffer pages-buffer)  
  695.     (widen)
  696.     (if end-of-directory-p
  697.         (goto-char (point-max))
  698.       (goto-char (marker-position pos)))
  699.     (if narrowing-p (narrow-to-page))))
  700.  
  701.  
  702. ;;; The `pages-directory-for-addresses' function and ancillary code
  703.  
  704. (defun pages-directory-for-addresses (&optional filename)
  705.   "Find addresses file and display its directory.
  706. By default, create and display directory of `pages-addresses-file-name'.
  707. Optional argument is FILENAME.  In interactive use, with prefix
  708. argument, prompt for file name and provide completion.
  709.  
  710. Move point to one of the lines in the displayed directory,
  711. then use \\[pages-directory-goto] to go to the same line
  712. in the addresses buffer.
  713.  
  714. If    pages-directory-for-addresses-goto-narrowing-p    is non-nil,
  715. `pages-directory-goto' narrows addresses buffer to entry.
  716.  
  717. If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
  718. this command deletes other windows when it displays the addresses 
  719. directory."
  720.  
  721.   (interactive
  722.    (list (if current-prefix-arg
  723.              (read-file-name "Filename: " pages-addresses-file-name))))
  724.  
  725.   (if (interactive-p)
  726.       (message "Creating directory for: %s "
  727.                (or filename pages-addresses-file-name)))
  728.   (if (file-exists-p (or filename pages-addresses-file-name))
  729.       (progn
  730.         (set-buffer
  731.          (find-file-noselect
  732.           (expand-file-name
  733.            (or filename pages-addresses-file-name))))
  734.         (widen)
  735.         (pages-directory t nil nil)
  736.         (pages-directory-address-mode)
  737.         (setq pages-directory-buffer-narrowing-p
  738.               pages-directory-for-addresses-goto-narrowing-p)
  739.         (or pages-directory-for-addresses-buffer-keep-windows-p
  740.             (delete-other-windows))
  741.         (save-excursion
  742.           (goto-char (point-min))
  743.           (delete-region (point) (save-excursion (end-of-line) (point)))
  744.           (insert
  745.            "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
  746.           (set-buffer-modified-p nil)
  747.           ))
  748.     (error "No addresses file found!")))
  749.  
  750. (defun pages-directory-address-mode ()
  751.   "Mode for handling the Addresses Directory buffer.
  752.  
  753. Move point to one of the lines in this buffer,
  754. then use \\[pages-directory-goto] to go
  755. to the same line in the pages buffer."
  756.  
  757.   (use-local-map pages-directory-map)
  758.   (setq major-mode 'pages-directory-address-mode)
  759.   (setq mode-name "Addresses Directory")
  760.   (make-local-variable 'pages-buffer)
  761.   (make-local-variable 'pages-pos-list)
  762.   (make-local-variable 'pages-directory-buffer-narrowing-p))
  763.  
  764.  
  765. ;;; Place `provide' at end of file.
  766. (provide 'page-ext)
  767.  
  768. ;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;;
  769.  
  770.